{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Majalan.Base.Objects
-- Copyright   :  (c) Stephen Tetley 2014
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Musical \"objects\" - chords, trills, etc. 
-- 
-- cf. Shapes in TikZ
--
--------------------------------------------------------------------------------

module Majalan.Base.Objects
  (  

    chord
  , chord_
  , tremolo
  , decTremolo
  , accTremolo
  , trill

  ) where

import Majalan.Base.Event
import Majalan.Base.Trail


import Control.Applicative
import Data.Monoid


-- Just a first draft - note Shapes in TikZ are much more 
-- interesting, e.g. they support anchors

chord :: Monoid a => [pch] -> (pch -> Event uctx a) -> Event uctx a
chord [] _  = zeroEvent mempty
chord ps mf = mconcat $ map mf ps

chord_ :: [pch] -> (pch -> Event uctx a) -> Event uctx ()
chord_ [] _  = zeroEvent ()
chord_ ps mf = mconcat $ map (\p -> const () <$> mf p) ps



-- Naming follows Havard.
-- tremolo - single note
-- trill - alternation - should be a second (interval) above the note



tremolo :: pch -> Int -> (pch -> EventFw uctx a) -> Event uctx ()
tremolo pch ntimes mf = askSymbolicDuration >>= \drn ->
   let patt   = divisiveTrail ntimes drn ()
   in compoundEventFw patt $ \_ -> mf pch >> return ()


decTremolo :: pch -> Int -> (pch -> EventFw uctx a) -> Event uctx ()
decTremolo pch ntimes mf = askSymbolicDuration >>= \drn ->
   let patt   = deceleratingTrail ntimes drn ()
   in compoundEventFw patt $ \_ -> mf pch >> return ()

accTremolo :: pch -> Int -> (pch -> EventFw uctx a) -> Event uctx ()
accTremolo pch ntimes mf = askSymbolicDuration >>= \drn ->
   let patt   = acceleratingTrail ntimes drn ()
   in compoundEvent patt $ \_ -> unfixWidth (mf pch) >> return ()


-- | Second pitch should be a second above first but that would tie
-- us to a fixed pitch representation (i.e ET12).
--
trill :: pch -> pch -> Int -> (pch -> EventFw uctx a) -> Event uctx ()
trill pch1 pch2 ntimes mf = askSymbolicDuration >>= \drn ->
   let patt = numberTrail 1 $ divisiveTrail ntimes drn ()
   in compoundEvent patt $ \i -> let p = if odd i then pch1 else pch2
                                 in unfixWidth (mf p) >> return ()


-- Trills and tremolos really need some over-time articulation
-- to sound good - e.g. decaying amplitude.

